;;************************************************************************
;; spinobj.lsp 
;; contains code for new and revised spin-proto and spin-overlay methods
;; portions of this code were written by Luke Tierney
;; portions copyright (c) 1991-98 by Forrest W. Young
;;************************************************************************

;;************************************************************************
;; spin-proto methods
;;************************************************************************

(defun spinplot (&rest args) (apply #'spin-plot args))
     
;fwy added vista-spinplot-proto dec 2002
 
(defproto vista-spinplot-proto () () spin-proto)
  
(defmeth vista-spinplot-proto :isnew 
  (&optional data 
        &key variable-labels point-labels
             (container nil) (show t) (top-most t) (pop-out nil) (actcon nil)
             (location '(50 50)) (size '(300 300))
             (menu t) (title "SpinPlot") 
             (legend1 (send $ :name)) (legend2 nil)
             (go-away t) (content-only nil))
  (call-next-method (length data) :variable-labels variable-labels
                    :title title :location location :size size 
                    :go-away go-away :show nil :scale-type nil
                    :has-v-scroll nil :has-h-scroll nil)
  (send self :add-points data)
  (send self :use-color t)
  (send self :point-color (iseq (send self :num-points)) 'blue)
  (send self :point-label (iseq (send self :num-points)) point-labels)
  (send self :showing-labels t)
  (send self :scale-type 'centroid-variable)
    (send self :point-symbol
          (iseq (send self :num-points)) 'disk)
    (when (< (send self :num-points) 25) (send self :showing-labels t))
  (send self :switch-add-box)
  ;  (send self :scaled-range 
  ;           (iseq (send self :num-variables)) -3 3)
  (send self :back-color 'white)
  (send self :pop-out-on pop-out)
  (send self :top-most t)
  (send self :adjust-to-data)
  (send self :container container)
  (let* ((nrots 0))
    (defmeth self :do-idle ()
      (call-next-method)
      (setf nrots (1+ nrots ))
      (when (= 0 (mod nrots 1000))
            (send self :adjust-to-data))))
  (when show (send self :show-window))
  (setf *current-graph* self)
  (setf *graph* self)
  (send *graph* :make-two-plot-menus
                "SpinPlot"
                :hotspot-items '(help dash new-x new-y new-z dash link dash
                                 faster slower dash
                                 print save copy)
                :popup-items   '(showing-labels mouse resize-brush dash
                                 erase-selection focus-on-selection 
                                 view-selection dash select-all show-all dash
                                 symbol color dash selection slicer))
  (if actcon 
      (enable-container actcon)
      (disable-container))
  self)

(defmeth spin-proto :isnew (&rest args)
  (apply #'call-next-method args)
  (send self :add-slot 'spin-on)
  (send self :add-slot 'show-box)
#+msdos  (send self :margin
        44 (+ 17 (send self :text-descent)) 
        3 (+ 18 (send self :text-descent)))
#-msdos  (send self :margin
        36 (+ 17 (send self :text-descent)) 
        3 (+ 19 (send self :text-descent)))
  (send self :add-overlay (send spin-control-overlay-proto :new))
  (send self :depth-cuing nil)
  (send self :use-color t)
  (send self  :mouse-mode 'hand-rotate)
  (send self :set-variables-with-labels '(0 1 2)
        (select (send self :variable-labels) '(0 1 2))) 
  (if (> (send self :num-variables) 3)
      (send self :plot-buttons :margin nil :box t  :new-z t)
      (send self :plot-buttons :margin nil :box t  :new-x nil :new-y nil))
  (send self :initial-spin (send *vista* :initial-spin))
  (send self :make-two-plot-menus
                "SpinPlot"
                :hotspot-items '(help dash new-x new-y new-z dash link dash
                                 faster slower dash
                                 print save copy)
                :popup-items   '(showing-labels mouse resize-brush dash
                                 erase-selection focus-on-selection 
                                 view-selection dash select-all show-all dash
                                 symbol color dash selection slicer))
  (setf *SP* self)
  )




(defmeth spin-proto :dim-sigma (i)
  (let* ((npts (send self :num-points))
         (dim1 (send self :point-transformed-coordinate 0 (iseq npts)))
         (dim2 (send self :point-transformed-coordinate 1 (iseq npts)))
         (dim3 (send self :point-transformed-coordinate 2 (iseq npts)))
         (Xt (matrix (list 3 npts) (combine dim1 dim2 dim3)))
         (X (transpose Xt))
         (Sigma (matmult Xt X))
         (eigvals (eigenvalues sigma))
         (ssq-diag (ssq (diagonal sigma)))
         (ssq-total (ssq (combine sigma)))
         (ssq-ratio (/ ssq-diag ssq-total))
         )
    (format t "Rotation ~d: EigenValues = ~a~%" i eigvals)
    ;(format t "Rotation ~d: SSQ-D = ~d SSQ-T = ~d D/T = ~d~%"
    ;        i ssq-diag ssq-total ssq-ratio)
    ))

(send spin-proto :black-on-white t) 

(defmeth spin-proto :show-box (&optional (logical nil set))
  (if set (setf (slot-value 'show-box) logical))
  (slot-value 'show-box))

(defmeth spin-proto :spin-on  (&optional (logical nil set))
  (if set (setf (slot-value 'spin-on) logical))
  (slot-value 'spin-on))

(defmeth spin-proto :initial-spin  (&optional (logical))
  (when logical
        (send self :transformation 
              #2A((0.995184734800228 0.0980170578041837 0.0) 
                  (-0.0980170578041837 0.99518473480023 0.0) 
                  (0.0 0.0 1.0)))
        (send self :slot-value 'rotation-type 'yawing)
        (send self :angle (* (send self :angle) .05))
        (send self :idle-on t)
        (send self :spin-on t)
        ))
 #|
(send spin-proto :menu-template 
      '(LINK SHOWING-LABELS MOUSE RESIZE-BRUSH DASH 
             ERASE-SELECTION FOCUS-ON-SELECTION SHOW-ALL 
             SYMBOL COLOR DASH FASTER SLOWER AXES redraw))


(defmeth spin-proto :menu-template ()
  '(help dash 
         new-x new-y new-z dash 
         link showing-labels mouse resize-brush dash
         erase-selection focus-on-selection show-all dash
	 select-data view-selection dash
         symbol color dash
         faster slower axes dash
         print save copy))
|#

(defmeth spin-proto :menu-template (&optional (values nil set))
  '(help dash 
         new-x new-y new-z dash 
         faster slower dash 
	 axes box dash
         print save copy))

(send spin-proto :menu-title "SpinPlot")

(defmeth spin-proto :scale-constant (&optional (m nil set) &key (draw t))
  (when (not (send self :has-slot 'scaled-range-constant))
        (send self :add-slot 'scaled-range-constant)
        (defmeth self :scaled-range-constant 
          (&optional (number nil set))
          (if set (setf (slot-value 'scaled-range-constant) number))
          (slot-value 'scaled-range-constant)))
  (when set
        (send self :scaled-range-constant m)
        (when draw (send self :adjust-to-data)))
  (send self :scaled-range-constant))

;;fwy modified Luke graph-proto scale-type method 04/18/00 in graphic0.lsp
;;the scale-type changes modify the way the adjust-to-data works
;;but no changes to adjust-to-data code were made

(defmeth spin-proto :adjust-to-data (&key (draw t))
  (call-next-method :draw nil)

  (when (not (send self :has-slot 'scaled-range-constant))
        (send self :add-slot 'scaled-range-constant)
        (defmeth self :scaled-range-constant 
                                 (&optional (number nil set))
          (if set (setf (slot-value 'scaled-range-constant) number))
          (slot-value 'scaled-range-constant)))

  (let* ((scale-type (send self :scale-type))
         (numpts (send self :num-points))
         (numvar (send self :num-variables))
         (ranges (send self :range (iseq 0 (- numvar 1))))
         (radius (* (sqrt numvar)
                    (max (- (min ranges)) (max ranges))))
         (constant (send self :scaled-range-constant))
         )
   
    (cond 
      ((null scale-type)
       (send self :center (iseq numvar) 0 :draw nil)
       (send self :range (iseq numvar) (- radius) radius :draw nil))
      ((or (equal scale-type 'centroid-variable)
           (equal scale-type 'centroid-fixed))
       (mapcar 
        #'(lambda (i)
            (send self :center i
                  (mean (send self :point-coordinate i (iseq numpts)))
                  :draw nil)) (iseq numvar))
       (cond
         ((equal scale-type 'centroid-variable)
          (mapcar 
           #'(lambda (i)
               (send self :scaled-range i (- (sqrt numvar)) (sqrt numvar)
                     :draw nil)) (iseq numvar)))
         (t
          (send self :range (iseq numvar) (- radius) radius :draw nil)))))
    (when constant
          (mapcar
           #'(lambda (i)
               (apply #'send self :scaled-range 
                 (combine i (* (send self :scaled-range i) 
                               (/ (sqrt constant) (sqrt numvar))))))
           (iseq numvar)))
    (when (> (send self :num-variables) 0) ;fwy added dec 29 2002
          (send self :scaled-range 
                   (iseq (send self :num-variables)) -2 2
                   :draw nil)) 
    (when draw
          (send self :resize)
          (send self :redraw))
    nil))


(defmeth spin-proto :set-variables-with-labels (v labs)
"Method Args: (variables labels)
Sets the variables indicated in the VARIABLES list to have the labels in 
the LABELS list.  All other variables are unlabeled."                                 
    (let ((n (send self :num-variables)))
            (send self :variable-label (iseq n) (repeat "" n))            
            (send self :variable-label v labs)))

(defmeth spin-proto :show-new-var (axis variable)
  (let* ((var-num (position variable (send self :variable-labels)))
         (cur-vars (send self :current-variables))
         (cur-var-names nil)
         (idling (send self :idle-on))
         )
    (cond
      ((equal (string-downcase axis) "x") (setf (select cur-vars 0) var-num))
      ((equal (string-downcase axis) "y") (setf (select cur-vars 1) var-num))
      ((equal (string-downcase axis) "z") (setf (select cur-vars 2) var-num))
      )
    (send self :clear-lines :draw nil)
    (setf cur-var-names (select (send self :variable-labels) cur-vars))
    (send self :idle-on nil)
    (apply #'send self :current-variables cur-vars)
    (send self :set-variables-with-labels cur-vars cur-var-names)
    (send self :transformation nil)
    (if (send self :scale-type) 
        (send self :add-box)
        (send self :redraw))
    (when (matrixp (send self :slot-value 'rotation-type))
          (send self :slot-value 'rotation-type 'yawing))
    (send self :idle-on idling)))

(defmeth spin-proto :switch-add-box (&key (draw t))
  (when (not (send self :has-slot 'show-box))
        (send self :add-slot 'show-box)
        (defmeth self :show-box (&optional (logical nil set))
          (if set (setf (slot-value 'show-box) logical))
          (slot-value 'show-box)))
  (send self :show-box (not (send self :show-box)))
  (send self :add-box :draw draw))

;;modification of Luke Tierney's ADD-BOX method by Forrest W. Young

(defmeth spin-proto :add-box (&key (draw t)) 
  (when (not (send self :has-slot 'show-box))
        (send self :add-slot 'show-box)
        (defmeth self :show-box (&optional (logical nil set))
          (if set (setf (slot-value 'show-box) logical))
          (slot-value 'show-box)))
  (when (not (send self :has-slot 'all-ranges))
        (send self :add-slot 'all-ranges)
        (defmeth self :all-ranges (&optional (list-of-lists nil set))
          (if set (setf (slot-value 'all-ranges) list-of-lists))
          (slot-value 'all-ranges)))
  (when (not (send self :all-ranges)) (send self :make-all-ranges))
  (send self :clear-lines :draw nil)
  ;(send self :use-color t)
  (when (send self :show-box)
        (let* ((cv (send self :current-variables))
               (nvar (send self :num-variables))
              ; (x (send self :raw-range (select cv 0)))
               (x  (- (send self :raw-range (select cv 0))
                      (send self :center (select cv 0))))
               (y (- (send self :raw-range (select cv 1))
                      (send self :center (select cv 1))))
               (z (- (send self :raw-range (select cv 2))
                      (send self :center (select cv 2))))
               (maxxyz (max (abs (combine x y z))))
               (values nil)
               (a nil)
               )
          (setf maxxyz (max (abs x)))
          (setf x (+ (send self :center (select cv 0))
                     (* 1.1 (list (- maxxyz) maxxyz))))
          (setf maxxyz (max (abs y)))
          (setf y (+ (send self :center (select cv 1))
                     (* 1.1 (list (- maxxyz) maxxyz))))
          (setf maxxyz (max (abs z)))
          (setf z (+ (send self :center (select cv 2))
                     (* 1.1 (list (- maxxyz) maxxyz)))) 
          (dotimes (i 2)
                   (if (= i 0)
                       (setf values (list (select x '(0 1 1 0 0))
                                          (select y '(0 0 1 1 0))
                                          (select z '(0 0 0 0 0))))
                       (setf values (list (select x '(0 1 1 0 0))
                                          (select y '(0 0 1 1 0))
                                          (select z '(1 1 1 1 1)))))
                   (setf a (repeat (list (repeat 0 5)) nvar))
                   (setf (select a cv) values)
                   (send self :add-lines a :line-width 1 :draw nil))
          
          (dotimes (i 4)
                   (case i
                     (0 (setf values (list (select x '(0 0))
                                           (select y '(0 0))
                                           (select z '(0 1)))))
                     (1 (setf values (list (select x '(0 0))
                                           (select y '(1 1))
                                           (select z '(0 1)))))
                     (2 (setf values (list (select x '(1 1))
                                           (select y '(1 1))
                                           (select z '(0 1)))))
                     (3 (setf values (list (select x '(1 1))
                                           (select y '(0 0))
                                           (select z '(0 1))))))
                   (setf a (repeat (list (repeat 0 2)) nvar))
                   (setf (select a cv) values)
                   (send self :add-lines a :line-width 1 :draw nil))))
          (when draw (send self :redraw-content)))
  
(defmeth spin-proto :raw-range (i)
  (list (select (select (send self :all-ranges) 0) i)
        (select (select (send self :all-ranges) 1) i)))

(defmeth spin-proto :make-all-ranges ()
  (send self :all-ranges 
        (list
         (mapcar (function (lambda (x) 
                (min (send self :point-coordinate x 
                           (iseq (send self :num-points)))))) 
                 (iseq (send self :num-variables)))
         (mapcar (function (lambda (x) 
                (max (send self :point-coordinate x 
                           (iseq (send self :num-points)))))) 
                 (iseq (send self :num-variables))))))

(defmeth spin-proto :box-scale ()
    (mapcar #'(lambda (i) 
              (send self :scaled-range i -1.2 1.2)) 
            (iseq (send self :num-variables))))

(defmeth spin-proto :scaled-ranges (r)
    (mapcar #'(lambda (i) 
              (send self :scaled-range i (- r) r))
            (iseq (send self :num-variables))))

(defmeth spin-proto :multiply-scaled-ranges (c)
    (mapcar #'(lambda (i) 
              (apply #' send self :scaled-range i 
                     (* c (send self :scaled-range i))))
            (iseq (send self :num-variables))))

;; Luke Tierney's hand-rotate method, modified for scale-constant fwy 12/14/97
;; add HAND ROTATE "mouse mode", with menu title, cursor and mouse method name

(send spin-proto :add-mouse-mode 'hand-rotate
      :title "Hand Rotate" :cursor 'hand :click :do-hand-rotate)

(flet ((calcsphere (x y)
        (let* ((constant (send self :scale-constant))
               (norm-2 (+ (* x x) (* y y)))
               (rad-2 (if constant ;first clause added fwy 12/14/97
                          (* 3 (/ (^ constant 2)
                                          (^ (send self :num-variables) 2)))
                          (^ 1.7 2)))
               (z (if (< norm-2 rad-2) (sqrt (- rad-2 norm-2)) 0)))
          (if (< norm-2 rad-2) 
              (list x y z)
              (let ((r (sqrt (max norm-2 rad-2))))
                (list (/ x r) (/ y r) (/ z r)))))))
 
  (defmeth spin-proto :do-hand-rotate (x y m1 m2)
    (let* ((oldp (apply #'calcsphere (send self :canvas-to-scaled x y)))
           (p oldp)
           (vars (send self :content-variables))
           (trans (identity-matrix (send self :num-variables))))
    ;  (send self :idle-on nil)
    ;  (when (send self :spin-on)
    ;        (send self :spin-on nil)
    ;        (send self :redraw-overlays))
      (send self :while-button-down 
            #'(lambda (x y) 
                (setf oldp p)
                (setf p (apply #'calcsphere 
                               (send self :canvas-to-scaled x y)))
                (setf (select trans vars vars) (make-rotation oldp p))
                (when m1 
                      (send self :slot-value 'rotation-type trans)
                      (send self :idle-on t)
                      
                      )
                (send self :apply-transformation trans))))))

(defmeth spin-proto :rock ()
  (send self :angle (* -1 (send self :angle))))


;;************************************************************************
;;Modification of Luke's spin-control-overlay-proto by Forrest W. Young
;;Zoom added 9/25/91. Speed, Go/Stop, Home, Clip and Rock added 12/7/97
;;************************************************************************

(defproto spin-control-overlay-proto 
          '(top lefts gap side ascent box-top text-base 
                downs first-down left-margin color-mode spin-on)
          ()
          graph-overlay-proto)

(defmeth spin-control-overlay-proto :color-mode 
  (&optional (logical nil set))
  (if set (setf (slot-value 'color-mode) logical))
  (slot-value 'color-mode))

(defmeth spin-control-overlay-proto :isnew ()
  (setf (slot-value 'gap) 3)
  (setf (slot-value 'side) 10)
  (setf (slot-value 'ascent) (send graph-proto :text-ascent))
  (let ((w1 (send graph-proto :text-width "Up/Dn")) ;Up/Dn Pitch
        (w2 (send graph-proto :text-width "C/CC"))  ;C/CC  Roll
        (w3 (send graph-proto :text-width "L/R"))   ;L/R   Yaw
        (w4 (send graph-proto :text-width "Speed"))
        (w5 (send graph-proto :text-width "Home"))
        (w6 (send graph-proto :text-width "Rock"))
        (w7 (send graph-proto :text-width "Zoom"))
        (w8 (send graph-proto :text-width "Renew"))
        (gap   (slot-value 'gap))
        (side  (slot-value 'side))
        (ascent (slot-value 'ascent)))
        
    (setf (slot-value 'left-margin) 
          (+ (send graph-proto :text-width "Home") (* 4 gap) (- 1)))
    
    (setf (slot-value 'lefts)
          (list (* 2 gap);0 up
                (+ (* 3 gap) side);1 dn
                (+ (* 6 gap) (* 2 side) w1);2 c
                (+ (* 7 gap) (* 3 side) w1);3 cc
                (+ (* 10 gap) (* 4 side) w1 w2);4 l
                (+ (* 11 gap) (* 5 side) w1 w2);5 r
                (+ (* 14 gap) (* 6 side) w1 w2 w3);6 +
                (+ (* 15 gap) (* 7 side) w1 w2 w3);7 -
                ))
    (setf (slot-value 'downs) 
              (list 0                          ; go/stop
                    (+ gap side gap ascent gap); home
                    (+ (* 2 (+ gap side gap ascent gap))); rock
                    (+ (* 3 (+ gap side gap ascent gap))); redraw
                    (+ (* 4 (+ gap side gap ascent gap))); zoom in
                    (+ (* 4 (+ gap side gap ascent gap))); zoom out
                    ))
    (send self :color-mode (> *color-mode* 0))
    ))

(defmeth spin-control-overlay-proto :resize ()
  (let* ((graph (send self :graph))
         (height (send graph :canvas-height))
         (bottom-margin (fourth (send graph :margin)))
         (top (+ (- height bottom-margin) 1))
         (gap (slot-value 'gap))
         (side (slot-value 'side))
         (ascent (send graph :text-ascent))
         (text-base (+ top gap (max side ascent)))
         (box-top (- text-base side)))
    (setf (slot-value 'top) top)
    (setf (slot-value 'text-base) text-base)
    (setf (slot-value 'box-top) box-top)))

(defmeth spin-control-overlay-proto :redraw ()
  (let* ((graph (slot-value 'graph))
         (draw-color (send graph :draw-color))
         (color-on? 
          (and (send (first (send graph :slot-value 'overlays)) :color-mode) 
               (> *color-mode* 0)))
         (top (+ 2 (slot-value 'top)))
         (cheat 2)
         (width (send graph :canvas-width))
         (lefts (slot-value 'lefts))
         (left-margin (slot-value 'left-margin))
         (top-margin (second (send graph :margin)))
         (downs (slot-value 'downs))
         (rect (send graph :content-rect))
         (gap (slot-value 'gap))
         (side (slot-value 'side))
         (text-base (1- (slot-value 'text-base)))
         (box-top (1- (slot-value 'box-top))))
#-msdos(setf cheat 3)
    (setf text-base (+ text-base cheat))
    (setf box-top   (+ box-top   cheat))
    (setf downs (+ downs 17 top-margin))
    (setf (select rect '(0 1)) (- (select rect '(0 1)) 1))
    (setf (select rect '(2 3)) (+ (select rect '(2 3)) 3))
    (dotimes (i 2)
             (if (< (select rect i) 0) (setf (select rect i) 0)))
    (if color-on?
        (send graph :draw-color 'toolbar-background)
        (send graph :draw-color 'white))
    (send graph :paint-rect 0 top (send graph :canvas-width) top)
    ;(send graph :paint-rect 0 0 left-margin (send graph :canvas-height))
    (send graph :paint-rect 
          2 top-margin (- left-margin gap 1) (- (first (last downs)) gap))
    (if color-on? ;(send *vista* :background-color)
        (send graph :draw-color draw-color)
        (send graph :draw-color 'black))
    (send graph :draw-line 0 top (send graph :canvas-width) top)
    (send graph :frame-rect 
          2 top-margin ; 2 18 
          (- left-margin gap 1) (- (first (last downs)) gap))
    (send graph :draw-line left-margin 16 left-margin top)
    (apply #'send graph :frame-rect rect)
    (mapcar #'(lambda (x) 
                (send self :draw-button nil x box-top side side))
            (select lefts (iseq 6)))
    (send self :draw-button nil (select lefts 6) box-top side side nil nil)
    (send self :draw-button nil (select lefts 7) box-top side side nil t)
    (mapcar #'(lambda (x y) 
                (send self :draw-button nil x y side side))                 
            (repeat (* 2 gap) 4)
            (select downs (iseq 4)))
    (send self :draw-button nil (* 2 gap) 
          (select downs 4) side side nil nil)
    (send self :draw-button nil (+ 3 (* 2 gap) side) 
          (select downs 5) side side nil t)
    (send self :draw-button (send graph :spin-on);spin-on
          (* 2 gap) (first downs) side side)
    (mapcar #'(lambda (s x y) (send graph :draw-string s x y))
            '("Up/Dn" "C/CC" "L/R" "Speed")
            (+ (select lefts '(1 3 5 7)) gap side) 
            (repeat text-base 4))
    (mapcar #'(lambda (s x y) (send graph :draw-string s x y))
            '("Spin" "Home" "Rock" "Clip" "Zoom")
            (repeat (* 2 gap) 5)
            (select (- downs gap) (iseq 5)))
    ))

(defmeth spin-control-overlay-proto :draw-button 
  (paint a b c d &optional while-button-down (plus-minus nil set))
"Args: PAINT A B C D &OPTIONAL WHILE-BUTTON-DOWN PLUS-MINUS
Draws a button at location A B, of size C D. Button painted if PAINT=T. Button also painted if WHILE-BUTTON-DOWN=T when button is down. If PLUS-MINUS is used has PLUS or MINUS sign when PLUS is T or Nil." 
  (let* ((graph (slot-value 'graph))
         (color-on? 
          (and (send (first (send graph :slot-value 'overlays)) :color-mode) 
               (> *color-mode* 0)))
         (on-color 'button-on-color)
         (off-color 'button-off-color))
    (when (not color-on?)
          (setf on-color 'black)
          (setf off-color 'white))
    (when paint 
          (send graph :draw-color on-color)
          (send graph :paint-rect a b c d)
          (send graph :draw-color 'black)
          (send graph :frame-rect a b c d)
          (when while-button-down
                (send graph :while-button-down 
                      #'(lambda (x y) nil))
                ))
    (when (or while-button-down (not paint))
          (send graph :draw-color off-color)
          (send graph :paint-rect a b c d)
          (send graph :draw-color 'black)
          (send graph :frame-rect a b c d)
          (when set
                (let ((g 1)
                      (h 0)
                      (j 1))
                  #+macintosh (setf g 0)
                  #+macintosh (setf h 1)
                  #+macintosh (setf j 0)
                  (send graph :line-width 2)
                  (send graph :draw-line 
                        (+ g a 2) (- (+ b (ceiling (/ d 2))) h)
                        (+ a g (- c 4)) (- (+ b (ceiling (/ d 2))) h))
                  (if plus-minus
                      (send graph :draw-line
                            (+ a g (- (floor (/ c 2)) 1)) (+ b j 2)
                            (+ a g (- (floor (/ c 2)) 1)) (+ b j (- d 4))))
                  (send graph :line-width 1))))))

(defmeth spin-control-overlay-proto :do-click (x y m1 m2)
  (let* ((graph (slot-value 'graph))
         (top (+ 2 (slot-value 'top)))
         (cheat 2)
         (width (send graph :canvas-width))
         (lefts (slot-value 'lefts))
         (left-margin (slot-value 'left-margin))
         (downs (slot-value 'downs))
         (top-margin (second (send graph :margin)))
         (gap (slot-value 'gap))
         (side (slot-value 'side))
         (big-small t)
         (multiplier 1.5)
         (nv (send graph :num-variables))
         (idling (send graph :idle-on))
         (text-base (1- (slot-value 'text-base)))
         (box-top (1- (slot-value 'box-top))))
#-msdos(setf cheat 3)
    (setf text-base (+ text-base cheat))
    (setf box-top   (+ box-top   cheat))
    (when (or (< x left-margin) (< top y))
    (cond 
      ((and (< y top ) (< x left-margin))
       (setf downs (+ downs 17 top-margin))
       (when (< (* 2 gap) x (+ (* 2 gap) side))
             (cond
;spin
               ((< (first downs) y (+ (first downs) side))
                (send self :draw-button (not (send graph :idle-on))
                      (* 2 gap) (first downs) side side)
                (send graph :spin-on (not (send graph :spin-on)))
                (send graph :idle-on (not (send graph :idle-on)))
                )
;home ok
               ((< (second downs)  y (+ (second downs) side))
                (send self :draw-button t
                      (* 2 gap) (second downs) side side t)
                (send graph :idle-on nil)
                (send graph :transformation nil)
                (send graph :redraw))
;rock doesn't work on hand rotate motion
               ((< (third downs)  y (+ (third downs) side))
                (send self :draw-button t
                      (* 2 gap) (third downs) side side t)
                (send graph :rock)
                (send graph :idle-on idling))
;clip ok
               ((< (fourth downs)  y (+ (fourth downs) side))
                (send self :draw-button t
                      (* 2 gap) (fourth downs) side side t)
                (send graph :redraw-background)
                (send graph :redraw-overlays)
                (send graph :redraw-content)
                (send graph :idle-on idling))
               ))
;zoom ok
       (when (< (fifth downs) y (+ (fifth downs) side))
             (when (or (< (* 2 gap) x (+ (* 2 gap) side))
                       (< (+ (* 3 gap) side) x (+ (* 3 gap) (* 2 side))))
                   (if (< (* 2 gap) x (+ (* 2 gap) side))
                       (setf big-small .975)
                       (setf big-small 1.025))
                   (send graph :while-button-down
                         #'(lambda (x y)
                             (if (< (* 2 gap) x (+ (* 2 gap) side)) 
                                 (send self :draw-button t
                                       (* 2 gap) (sixth downs) side side)
                                 (send self :draw-button t
                                       (+ (* 3 gap) side)
                                       (fifth downs) side side))
                             (send graph :scale (iseq nv) 
                                   (/ (send graph :scale (iseq nv)) 
                                      big-small))
                             )
                         nil)
                   (if (< (* 2 gap) x (+ (* 2 gap) side))
                       (send self :draw-button nil
                             (* 2 gap) (fifth downs) side side)
                       (send self :draw-button nil
                          (+ (* 3 gap) side) (fifth downs) side side nil t))
                   (send graph :redraw-background)
                   (send graph :redraw-overlays)
                   (send graph :redraw-content)
                   (send graph :idle-on idling))))
      ((< top y)
       (setf nv (send graph :num-variables))
       (if (< box-top y text-base)
           (let ((i (car (which (< lefts x (+ lefts side)))))
                 (angle (abs (send graph :angle))))
             (when i
                   (when (< i 6)
                         (send graph :idle-on nil)
                         (when (> i 3) (setf angle (- angle)))
                         (send graph :rotation-type 
                               (select '(pitching rolling yawing)
                                       (floor (/ i 2))))
                         (send graph :angle (if (oddp i) angle (- angle)))
                         (send graph :while-button-down
                               #'(lambda (x y)
                                   (send self :draw-button t
                                         (select lefts i) box-top side side) 
                                   (send graph :rotate))
                               nil)
                         (send self :draw-button nil
                                         (select lefts i) box-top side side)
                         (send graph :idle-on (or idling m1))
                         (when m1 (send self :draw-button t
                                        (* 2 gap) (+ 17 top-margin (first downs))
                                        side side))
                         )
;speed buttons
                   (when (> i 5)
                         (send graph :idle-on nil)
                         (setf multiplier (if (= i 6) .975 1.025))
                         (send self :draw-button t
                               (select lefts i) box-top side side)
                         (send graph :while-button-down
                               #'(lambda (x y)
                                   (send graph :angle 
                                         (* (send graph :angle) multiplier))
                                 ;change from  (send graph :do-idle) to:
                                   (send graph :rotate);??
                                   ) nil)
                         (send self :draw-button nil
                               (select lefts i) box-top side side nil 
                               (if (= i 6) nil t))
                         (send graph :idle-on idling)
                         )
                   )))))
      t)))